home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / XLIBP202.ZIP / FONTDEMO.PAS < prev    next >
Pascal/Delphi Source File  |  1994-06-11  |  3KB  |  133 lines
  1. {$IFDEF DPMI}
  2. {$C FIXED PRELOAD PERMANENT}
  3. {$ENDIF}
  4.  
  5.  
  6. Program fontdemo;
  7.  
  8. {$R-}
  9. uses
  10.     Xlib2, XMisc2, Dos, Crt;
  11.  
  12. const
  13.     swidth : array[0..9] of char =('0','1','2','3','4','5','6','7','8','9');
  14. var
  15.     fonts : array[0..127] of pointer;
  16.     names : array[0..127] of string[16];
  17.     i, fcount : integer;
  18.     c : char;
  19.  
  20. Type
  21.     Header = record
  22.         dummy : integer;
  23.         height, width : byte;
  24.     end;
  25.  
  26. procedure loaduserfonts;
  27. var
  28.     f : file;
  29.     len : word;
  30.     ASearchRec : SearchRec;
  31. begin
  32.     fcount := 0;
  33.     i := 0;
  34.     writeln('XLibPas FontDemo');
  35. {$IFDEF DPMI}
  36.     writeln('DPMI version');
  37. {$ENDIF}
  38.     findfirst('fonts\*.fnt',AnyFile, ASearchRec);
  39.     if doserror<>0 then
  40.     begin
  41.         writeln('No Fonts found in current directory!');
  42.         halt(0);
  43.     end;
  44.     writeln('Loading fonts...');
  45.     repeat
  46.         write(ASearchRec.name,',');
  47.         names[fcount] := ASearchRec.name;
  48.         assign( f, 'fonts\'+names[fcount] );
  49.         reset(f,1);
  50.         len := filesize(f);
  51.         getmem(fonts[fcount],len);
  52.         if fonts[fcount] = nil then
  53.         begin
  54.             writeln('Out of memory');
  55.             halt(0);
  56.         end;
  57.         blockread(f,fonts[fcount]^,len);
  58.         close(f);
  59.         inc(fcount);
  60.         findnext(ASearchRec)
  61.     until doserror<>0;
  62.     writeln;
  63.     writeln('Press ''v'' to view, any other key to quit');
  64.     c:=readkey;
  65.     if (c<>'V') and (c<>'v') then
  66.     begin
  67.         xtextmode;
  68.         halt(0);
  69.     end;
  70.     xtextinit;
  71.     xsetmode(XMODE320x240,320);
  72.     xregisteruserfont(fonts[0]^);
  73.     xsetfont(2);
  74. end;
  75.  
  76. const
  77.     extract : array[0..15] of string =
  78.         ('EXTRACT: Stephen King''s ''SALEM''S LOT'' ',
  79.             '',
  80.             'The memory rose up in almost total    ',
  81.             'sensory reference, and for the moment ',
  82.             'of its totality he was paralyzed. He  ',
  83.             'could even smell the plaster and the  ',
  84.             'wild odour of nesting animals. It     ',
  85.             'seemed to him that the plain varnished',
  86.             'door of Matt Burke''s guest room stood ',
  87.             'between him and all the secrets of    ',
  88.             'Hell. Then he twisted the knob and    ',
  89.             'pushed the door handle inwards...     ',
  90.             '',
  91.             'ABCDEFGHIJKLMNOPQRSTUVWXYZ            ',
  92.             'abcdefghijklmnopqrstuvwxyz 0123456789 ',
  93.             '~!@#$%^&*()_+|`-=\\{}[]:\'';''<>?,./    ');
  94.  
  95.  
  96.  
  97.  
  98. var
  99.     textline, strindex, height : integer;
  100.     s : string;
  101.  
  102. begin
  103.     loaduserfonts;
  104.     for i:=0 to fcount-1 do
  105.     begin
  106.         xsetfont(FONT8x8);
  107.         xrectfill(0, 0, 319, 240, 0, 0);
  108.             xline(0,9,319,9,14,0);
  109.             xline(0,ScrnPhysicalHeight-10,319,ScrnPhysicalHeight-10,14,0);
  110.             if Header(fonts[i]^).width = 0 then s := ' W=Variable'
  111.             else s := ' W='+xinttostr(Header(fonts[i]^).width,0);
  112.             xprintf(0,0,0,14,'Font '+names[i]+
  113.                                 ' H='+xinttostr(Header(fonts[i]^).height,0)+s);
  114.             xprintf(0,ScrnPhysicalHeight-8,0,14,'Press a key for next font...');
  115.             xregisteruserfont(fonts[i]^);
  116.             xsetfont(2);
  117.             height:=Header(fonts[i]^).height+1;
  118.             textline:=12;
  119.             strindex:=0;
  120.             while strindex<16 do
  121.             begin
  122.              xprintf(0,textline,0,14,extract[strindex]);
  123.              inc(strindex);
  124.              textline:=textline+height;
  125.             end;
  126.  
  127.             readkey;
  128.     end;
  129.     xtextmode;
  130. end.
  131.  
  132.  
  133.